perm filename ACK.LAP[VLI,LSP] blob sn#385508 filedate 1978-09-29 generic text, type T, neo UTF8
  ;****************************** 29-Sep-78 01:28:30 &PASS1 ;

   ( MAPC ' (
   ACK           ; 2SUBR ;
   REV           ; 2SUBR ;
   LIN           ; 2SUBR ;
   ALT           ; 3SUBR ;
  
   ) (LAMBDA (L) (PUT L NIL 'ENTRY)) )
  

  ;****************************** 29-Sep-78 01:28:30 &PASS2 ;

     ; 3 ACK-------------------------------------------------------

  (DE ACK (X Y) 
      (COND
         ((ZEROP X) (ADD1 X))
         ((ZEROP Y) (ACK (SUB1 X) 1))
         (T (ACK (SUB1 X) (ACK X (SUB1 Y))))))
  
   FUNCTION LENGTH = 38
   #LABEL = ((G101 POPJ P))
   #LAP LENGTH = 32
  ;
   ( LAP '(
  ;;;;;;
         (ENTRY ACK SUBR 2)
         (JSP L :SBIND2)
         (XWD 'ACK '(X Y))
         (CAIE 1 '0)
         (JRST 0 G102)
         (MOVE 5 :MEM 1)
         (ADDI 5 1)
         (JRST 0 :CRANUM)
   G102
         (GETVAL 1 Y)
         (CAIE 1 '0)
         (JRST 0 G103)
         (GETVAL 1 X)
         (MOVE 5 :MEM 1)
         (SUBI 5 1)
         (JSP L :$CRANB)
         (MOVEI 2 '1)
         (JRST 0 ACK)
   G103
         (GETVAL 1 X)
         (MOVE 5 :MEM 1)
         (SUBI 5 1)
         (JSP L :$CRANP)
         (GETVAL 1 X)
         (PUSH P 1)
         (GETVAL 1 Y)
         (MOVE 5 :MEM 1)
         (SUBI 5 1)
         (JSP L :$CRANB)
         (MOVEI 2 0 1)
         (POP P 1)
         (PUSHJ P ACK)
         (MOVEI 2 0 1)
         (POP P 1)
         (JRST 0 ACK)
  
   ) )
     ; 4 REV-------------------------------------------------------

  (DE REV (X Y) 
      (COND
         ((NULL X) Y)
         (T (REV (CDR X) [(CAR X) . Y]))))
  
   FUNCTION LENGTH = 26
   #LABEL = ((G105 POPJ P))
   #LAP LENGTH = 14
  ;
   ( LAP '(
  ;;;;;;
         (ENTRY REV SUBR 2)
         (JSP L :SBIND2)
         (XWD 'REV '(X Y))
         (JUMPN 1 G106)
         (GETVAL 1 Y)
         (POPJ P)
   G106
         (CDR 1 1)
         (PUSH P 1)
         (GETVAL 1 X)
         (CAR 1 1)
         (GETVAL 2 Y)
         (PUSHJ P CONS)
         (MOVEI 2 0 1)
         (POP P 1)
         (JRST 0 REV)
  
   ) )
     ; 5 LIN-------------------------------------------------------

  (DE LIN (L R) 
      (COND
         ((NULL L) R)
         ((ATOM L) [L . R])
         (T (LIN (CAR L) (LIN (CDR L) R)))))
  
   FUNCTION LENGTH = 34
   #LABEL = ((G108 POPJ P))
   #LAP LENGTH = 19
  ;
   ( LAP '(
  ;;;;;;
         (ENTRY LIN SUBR 2)
         (JSP L :SBIND2)
         (XWD 'LIN '(L R))
         (JUMPN 1 G109)
         (GETVAL 1 R)
         (POPJ P)
   G109
         (CAML 1 :BLIST)
         (JRST 0 G110)
         (GETVAL 1 R)
         (GETVAL 2 L)
         (JRST 0 XCONS)
   G110
         (CAR 1 1)
         (PUSH P 1)
         (GETVAL 1 L)
         (CDR 1 1)
         (GETVAL 2 R)
         (PUSHJ P LIN)
         (MOVEI 2 0 1)
         (POP P 1)
         (JRST 0 LIN)
  
   ) )
     ; 6 ALT-------------------------------------------------------

  (DE ALT (L M N) 
      (COND
         ((NULL L) NIL)
         ((= M 1) [(CAR L) . (ALT (CDR L) N N)])
         (T (ALT (CDR L) (1- M) N))))
  
   FUNCTION LENGTH = 42
   #LABEL = ((G112 POPJ P))
   #LAP LENGTH = 27
  ;
   ( LAP '(
  ;;;;;;
         (ENTRY ALT SUBR 3)
         (JSP L :SBIND3)
         (XWD 'ALT '(L M N))
         (GETVAL 1 L)
         (JUMPE 1 :VPOPJ)
   G113
         (GETVAL 1 M)
         (MOVEI 2 '1)
         (PUSHJ P =)
         (JUMPE 1 G114)
         (GETVAL 1 L)
         (CAR 1 1)
         (PUSH P 1)
         (GETVAL 1 L)
         (CDR 1 1)
         (GETVAL 2 N)
         (GETVAL 3 N)
         (PUSHJ P ALT)
         (POP P 2)
         (JRST 0 XCONS)
   G114
         (GETVAL 1 L)
         (CDR 1 1)
         (PUSH P 1)
         (GETVAL 1 M)
         (PUSHJ P 1-)
         (MOVEI 2 0 1)
         (POP P 1)
         (GETVAL 3 N)
         (JRST 0 ALT)
  
   ) )
  
  ;****************************** 29-Sep-78 01:28:33 COMPILEND ;